home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / XLISP 2.0 / XLISP Tools / Utility (UL) / STR-PRIM.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-04-07  |  2.1 KB  |  61 lines  |  [TEXT/ttxt]
  1. ;; Larry Mulcahy 1988
  2. ;; primitive string functions (the ones required by SEQUENCE)
  3.  
  4. (provide 'string-primitive)
  5.  
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7. ; string:position
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9. ; return the 0-origin position of the first occurrence of the
  10. ; character c in the string s.
  11. ; If not found, return nil.
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (defun string:position (c s)
  15.   (dotimes (i (length s) nil)
  16.        (if (equal c (char s i))
  17.            (return i))))
  18.  
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. ; string:position-if
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22.  
  23. (defun string:position-if (test s)
  24.   (dotimes (i (length s) nil)
  25.        (if (funcall test (char s i)) (return i))))
  26.  
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28. ; string:position-if-not
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30.  
  31. (defun string:position-if-not (test s)
  32.   (dotimes (i (length s) nil)
  33.        (if (not (funcall test (char s i))) (return i))))
  34.  
  35. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  36. ; string:substitute
  37. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38.  
  39. (defun string:substitute (new old string &key (test #'eql))
  40.   (let ((big (length string)))
  41.     (if (> big 0)
  42.         (dotimes (i big string)
  43.           (let ((c (char string i)))
  44.             (if (funcall test c old)
  45.                 (return
  46.                   (strcat (subseq string 0 i)
  47.                           (char->string new)
  48.                           (string:substitute new
  49.                                              old
  50.                                              (subseq string (1+ i))))))))
  51.         string)))
  52.  
  53. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  54. ; char->string
  55. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  56. ; With the change to version 2.0 this became a trivial function
  57.  
  58. (defun char->string (c) (string c))
  59.  
  60.  
  61.